home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol117 / descend.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-15  |  11.0 KB  |  382 lines
  1. 90  WIDTH "scrn:", 80
  2. 95  SCREEN 0,1,0,0
  3. 100  TITLE$ = "Descendents Chart Program"
  4. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  5. 110  VERSION$ = "Version 3.0"
  6. 115  COPY1$ = "Copyright (c) 1984, 1985, by:"
  7. 120  COPY2$ = "Melvin O. Duke"
  8. 125  PRICE$ = "$35"
  9. 130  ADDR1$ = "Melvin O. Duke"
  10. 135  ADDR2$ = "P. O. Box 20836"
  11. 140  ADDR3$ = "San Jose, CA  95160"
  12. 145  REM Dimension Statements go here
  13. 150  DIM PA.ID(1000), CH.ID(1000), PERS.NO(400), M.NO(400)
  14. 160  DIM PERS(2), PERSATLVL(5), SEXATLVL$(5), MARRATLVL(5),SPOUSATLVL(5)
  15. 165  DIM TEMPMAR(5), TEMPCHILD(5)
  16. 170  REM Produce the first screen
  17. 175  KEY OFF : CLS
  18. 180  REM Draw the outer double box
  19. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  20. 190  REM Find the title location
  21. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  22. 200  REM Draw the title box
  23. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  24. 210  REM Print the title
  25. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  26. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  27. 225  REM Draw the Contribution box
  28. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  29. 235  REM Request the Contribution
  30. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  31. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  32. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
  33. 255  REM Draw the Mailing Label
  34. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  35. 265  REM Print the Name and Address
  36. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  37. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  38. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  39. 285  REM Draw the Copyright box
  40. 290  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 400
  41. 295  REM Print the Copyright
  42. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  43. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  44. 310  GOTO 740
  45. 400  REM subroutine to print a double box
  46. 405  COLOR 5
  47. 410  FOR I = R1 + 1 TO R2 - 1
  48. 420   LOCATE I, C1 : PRINT CHR$(186);
  49. 430   LOCATE I, C2 : PRINT CHR$(186);
  50. 440  NEXT I
  51. 450  FOR J = C1 + 1 TO C2 - 1
  52. 460   LOCATE R1, J : PRINT CHR$(205);
  53. 470   LOCATE R2, J : PRINT CHR$(205);
  54. 480  NEXT J
  55. 490   LOCATE R1, C1 : PRINT CHR$(201);
  56. 500   LOCATE R1, C2 : PRINT CHR$(187);
  57. 510   LOCATE R2, C1 : PRINT CHR$(200);
  58. 520   LOCATE R2, C2 : PRINT CHR$(188);
  59. 525  COLOR 7
  60. 530  RETURN
  61. 600  REM subroutine to print a single box
  62. 605  COLOR 3
  63. 610  FOR I = R1 + 1 TO R2 - 1
  64. 620   LOCATE I, C1 : PRINT CHR$(179);
  65. 630   LOCATE I, C2 : PRINT CHR$(179);
  66. 640  NEXT I
  67. 650  FOR J = C1 + 1 TO C2 - 1
  68. 660   LOCATE R1, J : PRINT CHR$(196);
  69. 670   LOCATE R2, J : PRINT CHR$(196);
  70. 680  NEXT J
  71. 690   LOCATE R1, C1 : PRINT CHR$(218);
  72. 700   LOCATE R1, C2 : PRINT CHR$(191);
  73. 710   LOCATE R2, C1 : PRINT CHR$(192);
  74. 720   LOCATE R2, C2 : PRINT CHR$(217);
  75. 725  COLOR 7
  76. 730  RETURN
  77. 740  REM ask user to press a key to continue
  78. 750  LOCATE 25,1
  79. 760  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  80. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  81. 780  CLS
  82. 840  CLS
  83. 1000  REM Descendents Chart Program.
  84. 1010  REM By:  Melvin O. Duke.  Last Updated:  24 December 1984.
  85. 1020  REM Set for Wide Printing.
  86. 1030  WIDTH "lpt1:",132 'For printing Descendent Charts
  87. 1040  REM set initial color
  88. 1050  COLOR 7,0
  89. 1060  REM Ask about whether to print
  90. 1070  PRT.SW = 0
  91. 1080  LOCATE 19,1
  92. 1085  PRINT "Descendents Charts will be Displayed."
  93. 1090  INPUT "Do you want to Print as well as to Display";REPLY$
  94. 1100  IF LEFT$(REPLY$,1)="y" OR LEFT$(REPLY$,1) ="Y"THEN PRT.SW = 1
  95. 1110  ON PRT.SW+1 GOTO 1170, 1130
  96. 1120  STOP
  97. 1130  CLS : LOCATE 21,1 : PRINT "Make sure that the Printer is On and Ready"
  98. 1140  REM
  99. 1150  LOCATE 23,1 : PRINT "Then press any key"
  100. 1160  A$ = INKEY$ : IF A$ = "" THEN 1160
  101. 1170  CLS
  102. 1180  REM Read the Parent/Child Index
  103. 1190  OPEN "a:pcindex" FOR INPUT AS #1
  104. 1200  LOCATE 4,1 : PRINT "Open the Parent/Child Index";
  105. 1210  INPUT #1, PC.COUNT
  106. 1220  FOR I = 1 TO PC.COUNT
  107. 1230  LOCATE 5,1 : PRINT "Reading Index Record #:";I;
  108. 1240   INPUT #1, PA.ID(I), CH.ID(I)
  109. 1250  NEXT I
  110. 1260  CLOSE #1
  111. 1270  REM Read the Marriage Index
  112. 1280  LOCATE 7,1 : PRINT "Open the Marriage Index";
  113. 1290  OPEN "a:mindex" FOR INPUT AS #2
  114. 1300  INPUT #2, M.COUNT
  115. 1310  FOR I = 1 TO M.COUNT
  116. 1320  LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I:
  117. 1330   INPUT #2,PERS.NO(I), M.NO(I)
  118. 1340  NEXT I
  119. 1350  CLOSE #2
  120. 1360  REM Open the Persons File
  121. 1370  LOCATE 10,1 : PRINT "Open the Persons File"
  122. 1380  OPEN "a:persfile" AS #1 LEN = 256
  123. 1390  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  124. 1400  REM open the Marriages File
  125. 1410  LOCATE 12,1 : PRINT "Open the Marriage File"
  126. 1420  OPEN "a:marrfile" AS #2 LEN = 128
  127. 1430  FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$, 11 AS M5$, 18 AS M6$, 16 AS M7$, 16 AS M8$, 45 AS M9$
  128. 1440  REM Obtain a Person Record from the User
  129. 1450  LOCATE 20,1
  130. 1460  INPUT "Enter the Record-number of a Person (0 to quit)"; PERSON
  131. 1470  IF PERSON = 0 THEN 3830
  132. 1480  IF PERSON < 1 OR PERSON > 500 THEN CLS: GOTO 1440
  133. 1490  GOTO 2090
  134. 1500  REM Reset the Printer Characteristics for next page if required.
  135. 1510  REM Don't stop.  Forms are continuous, and 11 inches.
  136. 1520  RETURN
  137. 1530  REM Routine to do a Right-trim
  138. 1540  FOR J = 1 TO LEN(TEMP1$)
  139. 1550   IF RIGHT$(TEMP2$,1) = " " THEN TEMP2$ = LEFT$(TEMP2$,LEN(TEMP2$)-1) ELSE J = LEN(TEMP1$)
  140. 1560  NEXT J
  141. 1570  RETURN
  142. 1580  REM Routine to Extract Personal Information
  143. 1590  T1 = CVS(F1$)
  144. 1600  TEMP1$ = F2$ : TEMP2$ = F2$ : GOSUB 1530
  145. 1610  T2$ = TEMP2$
  146. 1620  TEMP1$ = F3$ : TEMP2$ = F3$ : GOSUB 1530
  147. 1630  T3$ = TEMP2$
  148. 1640  IF LEFT$(F4$,1) = "M" THEN T4$ = "M"
  149. 1650  IF LEFT$(F4$,1) = "F" THEN T4$ = "F"
  150. 1660  T5 = CVS(F5$)
  151. 1670  T6 = CVS(F6$)
  152. 1680  T7 = CVS(F7$)
  153. 1690  TEMP1$ = F8$ : TEMP2$ = F8$ : GOSUB 1530
  154. 1700  T8$ = TEMP2$
  155. 1710  TEMP1$ = F9$ : TEMP2$ = F9$ : GOSUB 1530
  156. 1720  T9$ = TEMP2$
  157. 1730  TEMP1$ = F10$ : TEMP2$ = F10$ : GOSUB 1530
  158. 1740  T10$ = TEMP2$
  159. 1750  TEMP1$ = F11$ : TEMP2$ = F11$ : GOSUB 1530
  160. 1760  T11$ = TEMP2$
  161. 1770  TEMP1$ = F12$ : TEMP2$ = F12$ : GOSUB 1530
  162. 1780  T12$ = TEMP2$
  163. 1790  TEMP1$ = F13$ : TEMP2$ = F13$ : GOSUB 1530
  164. 1800  T13$ = TEMP2$
  165. 1810  TEMP1$ = F14$ : TEMP2$ = F14$ : GOSUB 1530
  166. 1820  T14$ = TEMP2$
  167. 1830  TEMP1$ = F15$ : TEMP2$ = F15$ : GOSUB 1530
  168. 1840  T15$ = TEMP2$
  169. 1850  TEMP1$ = F16$ : TEMP2$ = F16$ : GOSUB 1530
  170. 1860  T16$ = TEMP2$
  171. 1870  TEMP1$ = F17$ : TEMP2$ = F17$ : GOSUB 1530
  172. 1880  T17$ = TEMP2$
  173. 1890  TEMP1$ = F18$ : TEMP2$ = F18$ : GOSUB 1530
  174. 1900  T18$ = TEMP2$
  175. 1910  TEMP1$ = F19$ : TEMP2$ = F19$ : GOSUB 1530
  176. 1920  T19$ = TEMP2$
  177. 1930  RETURN
  178. 1940  RETURN
  179. 1950  REM Extraction of Marriage Information
  180. 1960  TT1 = CVS(M1$)  'Rec.no
  181. 1970  TT2 = CVS(M2$)  'Husband
  182. 1980  TT3 = CVS(M3$)  'Wife
  183. 1990  TT4 = CVS(M4$)  'Code
  184. 2000  TEMP1$ = M5$ : TEMP2$ = M5$ : GOSUB 1530
  185. 2010  TT5$ = TEMP2$  'Marriage Date
  186. 2020  TEMP1$ = M6$ : TEMP2$ = M6$ : GOSUB 1530
  187. 2030  TT6$ = TEMP2$   'City
  188. 2040  TEMP1$ = M7$ : TEMP2$ = M7$ : GOSUB 1530
  189. 2050  TT7$ = TEMP2$   'County
  190. 2060  TEMP1$ = M8$ : TEMP2$ = M8$ : GOSUB 1530
  191. 2070  TT8$ = TEMP2$   'State
  192. 2080  RETURN
  193. 2090  REM Routine to Produce a Descendents Chart
  194. 2100  REM First of all, set all numbers to 0 and letters to -
  195. 2110  FOR ATLVL = 1 TO 4
  196. 2120   PERSATLVL(ATLVL) = 0
  197. 2130   SEXATLVL$(ATLVL) = "-"
  198. 2140   MARRATLVL(ATLVL) = 0
  199. 2150   SPOUSATLVL(ATLVL) = 0
  200. 2160  NEXT ATLVL
  201. 2170  REM Establish a starting-point for level 1
  202. 2180  LEVEL = 1
  203. 2190  PERSATLVL(LEVEL) = PERSON
  204. 2200  GET #1, PERSATLVL(LEVEL)
  205. 2210  GOSUB 1580  'for Person's Information
  206. 2211  REM Test if Empty
  207. 2212  IF T1 > 0 THEN 2220
  208. 2213  CLS : LOCATE 20,1 : PRINT "Record";PERSON;"is Empty"
  209. 2214  GOTO 2510
  210. 2220  SEXATLVL$(LEVEL) = T4$
  211. 2230  ON PRT.SW+1 GOTO 2340, 2240
  212. 2240  REM Print the Title on the First Page, Date, Time, and Person Indicated
  213. 2250  LPRINT "Four-Generation Descendents Chart for ";T3$;" ";T2$
  214. 2260  LPRINT
  215. 2270  LPRINT "From the Genealogy ON DISPLAY Computerized Data Base"
  216. 2280  LPRINT "Prepared on (date): ";DATE$;" at (time): ";TIME$
  217. 2290  LPRINT : LPRINT
  218. 2300  LPRINT "  Descendent";TAB(46);"Person";TAB(56);"Marriage"
  219. 2310  LPRINT "   Spouse";TAB(46);"Number";TAB(56);"Date";TAB(69);"Birth Date"
  220. 2320  FOR VERT = 1 TO 79 : LPRINT "-";: NEXT VERT : LPRINT
  221. 2330  LPRINT T3$;" ";T2$;TAB(46);T1;TAB(69);T8$
  222. 2340   CLS : PRINT "Four-Generation Descendents Chart for ";
  223. 2350   PRINT T3$;" ";T2$ : COLOR 6,0
  224. 2360   PRINT
  225. 2370   PRINT "From the Genealogy ON DISPLAY Computerized Data Base"
  226. 2380   PRINT "Prepared on (date): ";DATE$;" at (time): ";TIME$
  227. 2390   PRINT :  PRINT : COLOR 6,0
  228. 2400   PRINT "  Descendent";TAB(46);"Person";TAB(56);"Marriage"
  229. 2410   PRINT "   Spouse";TAB(46);"Number";TAB(56);"Date";TAB(69);"Birth Date"
  230. 2420  COLOR 5,0 : FOR VERT = 1 TO 79 :  PRINT "-";: NEXT VERT :  PRINT
  231. 2430  COLOR 2,0 : PRINT T3$;" ";T2$;
  232. 2440  PRINT TAB(46);
  233. 2450  COLOR 0,7 : PRINT T1;
  234. 2460  COLOR 2,0 : PRINT TAB(69); T8$
  235. 2470  COLOR 7,0
  236. 2480  GOSUB 2560
  237. 2490  ON PRT.SW+1 GOTO 2510,2500
  238. 2500  LPRINT CHR$(12);
  239. 2510  PRINT
  240. 2520  PRINT "Press any key to continue"
  241. 2530  A$ = INKEY$ : IF A$ = "" THEN 2530
  242. 2540  CLS
  243. 2550  GOTO 1440
  244. 2560  REM Locate an unreported marriage, if present
  245. 2570  FOR MRECATLVL = 1 TO M.COUNT
  246. 2580   IF PERS.NO(MRECATLVL) < PERSATLVL(LEVEL) THEN 3200 'Not there yet
  247. 2590   IF PERS.NO(MRECATLVL) > PERSATLVL(LEVEL) THEN MRECATLVL = M.COUNT : GOTO 3200
  248. 2600   REM found a marriage.  Try to accept it.
  249. 2610   IF MARRATLVL(LEVEL) <> 0 AND MARRATLVL(LEVEL) = M.NO(MRECATLVL) THEN 3200
  250. 2620   IF MARRATLVL(LEVEL) = 0 THEN MARRATLVL(LEVEL) = M.NO(MRECATLVL)
  251. 2630   REM get the marriage record, and the spouse
  252. 2640   GET #2, M.NO(MRECATLVL)
  253. 2650   GOSUB 1950  'to Extract Marriage Information
  254. 2660   IF SEXATLVL$(LEVEL) = "M" THEN SELF = TT2 : SPOUSE = TT3
  255. 2670   IF SEXATLVL$(LEVEL) = "F" THEN SELF = TT3 : SPOUSE = TT2
  256. 2680   SPOUSATLVL(LEVEL) = SPOUSE
  257. 2690   PERSAT(LEVEL) = SELF
  258. 2700   GET #1, SPOUSE
  259. 2710   GOSUB 1580  'to Extract Personal Information
  260. 2720  ON PRT.SW+1 GOTO 2790, 2730
  261. 2730   REM Now print the Spouse
  262. 2740   FOR VERT = 2 TO LEVEL
  263. 2750    LPRINT "| ";
  264. 2760   NEXT VERT
  265. 2770   LPRINT " ";
  266. 2780   LPRINT T3$;" ";T2$;TAB(46);T1;TAB(56);TT5$;TAB(69);T8$
  267. 2790   COLOR 5,0
  268. 2800   FOR VERT = 2 TO LEVEL
  269. 2810     PRINT "| ";
  270. 2820   NEXT VERT
  271. 2830    PRINT " ";
  272. 2840    COLOR 2,0 : PRINT T3$;" ";T2$;
  273. 2850    PRINT TAB(46);
  274. 2860    COLOR 0,7 : PRINT T1;
  275. 2870    COLOR 4,0 : PRINT TAB(56); TT5$;
  276. 2880    PRINT TAB(69);
  277. 2890    COLOR 2,0 : PRINT T8$
  278. 2900    COLOR 7,0
  279. 2910   REM Line After the Spouse
  280. 2920  ON PRT.SW+1 GOTO 3010, 2930
  281. 2930   FOR VERT = 2 TO LEVEL
  282. 2940    LPRINT "| ";
  283. 2950   NEXT VERT
  284. 2960   LPRINT "+";
  285. 2970   FOR VERT = LEVEL*2 TO 79
  286. 2980    LPRINT "-";
  287. 2990   NEXT VERT
  288. 3000   LPRINT
  289. 3010   COLOR 5,0 : FOR VERT = 2 TO LEVEL
  290. 3020     PRINT "| ";
  291. 3030   NEXT VERT
  292. 3040    PRINT "+";
  293. 3050   FOR VERT = LEVEL*2 TO 79
  294. 3060     PRINT "-";
  295. 3070   NEXT VERT
  296. 3080    PRINT : COLOR 7,0
  297. 3090   TEMPMAR(LEVEL) = MRECATLVL        'Save the Index
  298. 3100   REM now look for children
  299. 3110   LEVEL = LEVEL + 1
  300. 3120   GOSUB 3220                        'Look for Children of this Marriage
  301. 3130   REM blank prior level
  302. 3140   PERSATLVL(LEVEL) = 0
  303. 3150   SEXATLVL$(LEVEL) = "-"
  304. 3160   MARRATLVL(LEVEL) = 0
  305. 3170   SPOUSATLVL(LEVEL) = 0
  306. 3180   LEVEL = LEVEL -1
  307. 3190   MRECATLVL = TEMPMAR(LEVEL)        'Restore the Index
  308. 3200  NEXT MRECATLVL
  309. 3210  RETURN
  310. 3220  REM Search for Children of the Marriage
  311. 3230  IF LEVEL > 4 THEN RETURN
  312. 3240  FOR LL = 1 TO PC.COUNT
  313. 3250   IF PERSATLVL(LEVEL-1) > PA.ID(LL) THEN 3620
  314. 3260   IF PERSATLVL(LEVEL-1) < PA.ID(LL) THEN LL = PC.COUNT : GOTO 3620
  315. 3270   REM found a child.  Try to accept.
  316. 3280   PERSATLVL(LEVEL) = CH.ID(LL)
  317. 3290   GET #1, CH.ID(LL)
  318. 3300   GOSUB 1580  'To extract personal information
  319. 3310   REM identify that both parents match
  320. 3320   IF SEXATLVL$(LEVEL-1) = "M" THEN 3350
  321. 3330   IF SEXATLVL$(LEVEL-1) = "F" THEN 3390
  322. 3340   STOP
  323. 3350   REM Male Parent in Direct Line
  324. 3360   IF PERSATLVL(LEVEL-1) <> T6 THEN 3620
  325. 3370   IF SPOUSATLVL(LEVEL-1) <> T7 THEN 3620
  326. 3380   GOTO 3420
  327. 3390   REM Female Parent in Direct Line
  328. 3400   IF PERSATLVL(LEVEL-1) <> T7 THEN 3620
  329. 3410   IF SPOUSATLVL(LEVEL-1) <> T6 THEN 3620
  330. 3420   REM Passed All Tests, so print this child
  331. 3430  ON PRT.SW+1 GOTO 3480, 3440
  332. 3440   FOR VERT = 2 TO LEVEL
  333. 3450    LPRINT "| ";
  334. 3460   NEXT VERT
  335. 3470   LPRINT T3$;" ";T2$;TAB(46);T1;TAB(69);T8$
  336. 3480   COLOR 5,0 : FOR VERT = 2 TO LEVEL
  337. 3490     PRINT "| ";
  338. 3500   NEXT VERT
  339. 3510    COLOR 2,0 : PRINT T3$;" ";T2$;
  340. 3520    PRINT TAB(46);
  341. 3530    COLOR 0,7 : PRINT T1;
  342. 3540    COLOR 2,0 : PRINT TAB(69);T8$
  343. 3550    COLOR 7,0
  344. 3560   REM save information at this level
  345. 3570   SEXATLVL$(LEVEL) = T4$
  346. 3580   REM Search for Spouse
  347. 3590   TEMPCHILD(LEVEL) = LL             'Save the Index
  348. 3600   GOSUB 2560  'for Marriage Search
  349. 3610   LL = TEMPCHILD(LEVEL)             'Restore the Index
  350. 3620  NEXT LL
  351. 3630  REM Print a line after last child
  352. 3640  ON PRT.SW+1 GOTO 3725, 3650
  353. 3650   FOR VERT = 1 TO 2*LEVEL-4 STEP 2
  354. 3660    LPRINT "| ";
  355. 3670   NEXT VERT
  356. 3680   LPRINT "+";
  357. 3690   FOR VERT = 2*LEVEL-2 TO 79
  358. 3700    LPRINT "-";
  359. 3710   NEXT VERT
  360. 3720   LPRINT
  361. 3725  COLOR 5
  362. 3730   FOR VERT = 1 TO 2*LEVEL-4 STEP 2
  363. 3740     PRINT "| ";
  364. 3750   NEXT VERT
  365. 3760    PRINT "+";
  366. 3770   FOR VERT = 2*LEVEL-2 TO 79
  367. 3780     PRINT "-";
  368. 3790   NEXT VERT
  369. 3800    PRINT : COLOR 7,0
  370. 3810  RETURN
  371. 3820  STOP : GOTO 1440  'for Next Descendent Chart
  372. 3830  REM Wrapup
  373. 3840  CLOSE #1
  374. 3850  CLOSE #2
  375. 3860  CLS : LOCATE 21,1
  376. 3870  PRINT "End of Program"
  377. 3880  ON PRT.SW+1 GOTO 3910, 3890
  378. 3890  REM Final Page Eject when through
  379. 3900  LPRINT CHR$(12);     'Page Eject
  380. 3910  RUN "a:menu"
  381. 3920  END
  382.